Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
(* AMIGA *)
MODULE Oberon; (*JG 6.9.90*)	(* << RC 19.3.93, shml, cn 2.6.94 *)
	IMPORT SYSTEM, Amiga, AmigaTimer, Kernel, Modules, Input, Display, Fonts, Viewers, Texts, V24, AmigaIntuition;
	CONST
		(*message ids*)
		consume* = 0; track* = 1; (* InputMsg *)
		defocus* = 0; neutralize* = 1; mark* = 2; (* ControlMsg *)
		BasicCycle = 20;
		ESC = 1BX; SETUP = 0A4X;
	TYPE
		Painter* = PROCEDURE (x, y: INTEGER);
		Marker* = RECORD Fade*, Draw*: Painter END;
		Cursor* = RECORD
			marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
		END;
		ParList* = POINTER TO ParRec;
		ParRec* = RECORD
			vwr*: Viewers.Viewer;
			frame*: Display.Frame;
			text*: Texts.Text;
			pos*: LONGINT
		END;
		InputMsg* = RECORD (Display.FrameMsg)
			id*: INTEGER;
			keys*: SET;
			X*, Y*: INTEGER;
			ch*: CHAR;
			fnt*: Fonts.Font;
			col*, voff*: SHORTINT
		END;
		SelectionMsg* = RECORD (Display.FrameMsg)
			time*: LONGINT;
			text*: Texts.Text;
			beg*, end*: LONGINT
		END;
		ControlMsg* = RECORD (Display.FrameMsg)
			id*, X*, Y*: INTEGER
		END;
		CopyOverMsg* = RECORD (Display.FrameMsg)
			text*: Texts.Text;
			beg*, end*: LONGINT
		END;
		CopyMsg* = RECORD (Display.FrameMsg)
			F*: Display.Frame
		END;
		Task* = POINTER TO TaskDesc;
		Handler* = PROCEDURE;
		TaskDesc* = RECORD
			next: Task;
			safe*: BOOLEAN;
			time*: LONGINT;
			handle*: Handler
		END;
		User*: ARRAY 8 OF CHAR;
		Password*: LONGINT;
		Arrow*, Star*: Marker;
		Mouse*, Pointer*: Cursor;
		FocusViewer*: Viewers.Viewer;
		Log*: Texts.Text;
		Par*: ParList; (*actual parameters*)
		CurTask*, PrevTask: Task;
		CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
		DW, DH, CL, H0, H1, H2, H3: INTEGER;
		unitW: INTEGER;
		ActCnt: INTEGER; (*action count for GC*)
		Mod: Modules.Module;
	(*user identification*)
	PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
		VAR i: INTEGER; a, b, c: LONGINT;
	BEGIN
		a := 0; b := 0; i := 0;
		WHILE s[i] # 0X DO
			c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]);
			INC(i)
		END;
		IF b >= 32768 THEN b := b - 65536 END;
		RETURN b * 65536 + a
	END Code;
	PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
	BEGIN COPY(user, User); Password := Code(password)
	END SetUser;
	(*clocks*)
	PROCEDURE GetClock* (VAR t, d: LONGINT);
	BEGIN Kernel.GetClock(t, d)
	END GetClock;
	PROCEDURE SetClock* (t, d: LONGINT);
	BEGIN Kernel.SetClock(t, d)
	END SetClock;
	PROCEDURE Time* (): LONGINT;
	BEGIN RETURN Input.Time()
	END Time;
	(*cursor handling*)
	PROCEDURE FlipArrow (X, Y: INTEGER);
	BEGIN
		(*IF X < CL THEN *)
			(*IF X > DW - 15 THEN X := DW - 15 END *)
		(*ELSE *)
			(*IF X > CL + DW - 15 THEN X := CL + DW - 15 END *)
		(*END; *)
		(*IF Y < 14 THEN Y := 14 ELSIF Y > DH THEN Y := DH END; *)
		IF X < CL THEN X := CL ELSIF X > CL + DW-1 THEN X := CL + DW-1 END;
		IF Y < 0 THEN Y := 0 ELSIF Y > DH THEN Y := DH END;
		Display.CopyPattern(Display.white, Display.arrow, X, Y - 14, 2)
	END FlipArrow;
	PROCEDURE FlipStar (X, Y: INTEGER);
	BEGIN
		IF X < CL THEN
			IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
		ELSE
			IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END
		END ;
		IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END;
		Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
	END FlipStar;
	PROCEDURE OpenCursor* (VAR c: Cursor);
	BEGIN c.on := FALSE; c.X := 0; c.Y := 0
	END OpenCursor;
	PROCEDURE FadeCursor* (VAR c: Cursor);
	BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
	END FadeCursor;
	PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
	BEGIN
		IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
			c.marker.Fade(c.X, c.Y); c.on := FALSE
		END;
		IF ~c.on THEN
			m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
		END
	END DrawCursor;
	(*display management*)
	PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
	BEGIN
		IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN
			FadeCursor(Mouse)
		END;
		IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN
			FadeCursor(Pointer)
		END
	END RemoveMarks;
	PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
	BEGIN
		WITH V: Viewers.Viewer DO
			IF M IS InputMsg THEN
				WITH M: InputMsg DO
					IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
				END
			ELSIF M IS ControlMsg THEN
				 WITH M: ControlMsg DO
					 IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
				 END
			ELSIF M IS Viewers.ViewerMsg THEN
				WITH M: Viewers.ViewerMsg DO
					IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
						RemoveMarks(V.X, V.Y, V.W, V.H);
						Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
					ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
						RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
						Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
					END
				END
			END
		END
	END HandleFiller;
	PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
		VAR Filler: Viewers.Viewer;
	BEGIN
		 Input.SetMouseLimits(Viewers.curW + UW + SW, H);
		 Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
		 NEW(Filler); Filler.handle := HandleFiller;
		 Viewers.InitTrack(UW, H, Filler); (*init user track*)
		 NEW(Filler); Filler.handle := HandleFiller;
		 Viewers.InitTrack(SW, H, Filler) (*init system track*)
	END OpenDisplay;
	PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
	BEGIN RETURN DW
	END DisplayWidth;
	PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
	BEGIN RETURN DH
	END DisplayHeight;
	PROCEDURE OpenTrack* (X, W: INTEGER);
		VAR Filler: Viewers.Viewer;
	BEGIN
		NEW(Filler); Filler.handle := HandleFiller;
		Viewers.OpenTrack(X, W, Filler)
	END OpenTrack;
	PROCEDURE UserTrack* (X: INTEGER): INTEGER;
	BEGIN RETURN X DIV DW * DW
	END UserTrack;
	PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
	BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
	END SystemTrack;
	PROCEDURE UY (X: INTEGER): INTEGER;
		VAR fil, bot, alt, max: Display.Frame;
	BEGIN
		Viewers.Locate(X, 0, fil, bot, alt, max);
		IF fil.H >= DH DIV 8 THEN RETURN DH END;
		RETURN max.Y + max.H DIV 2
	END UY;
	PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
	BEGIN
		IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
		ELSE X := DX DIV DW * DW; Y := UY(X)
		END
	END AllocateUserViewer;
	PROCEDURE SY (X: INTEGER): INTEGER;
		VAR fil, bot, alt, max: Display.Frame;
	BEGIN
		Viewers.Locate(X, DH, fil, bot, alt, max);
		IF fil.H >= DH DIV 8 THEN RETURN DH END;
		IF max.H >= DH - H0 THEN RETURN max.Y + H3 END;
		IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END;
		IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END;
		IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
		IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
		RETURN alt.Y + alt.H DIV 2
	END SY;
	PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
	BEGIN
		IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
		ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
		END
	END AllocateSystemViewer;
	PROCEDURE MarkedViewer* (): Viewers.Viewer;
	BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
	END MarkedViewer;
	PROCEDURE PassFocus* (V: Viewers.Viewer);
		VAR M: ControlMsg;
	BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V
	END PassFocus;
	(*command interpretation*)
	PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
		VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
	BEGIN
		(*Amiga.Turbo; (* set task priority high *)*) 	(*<<RD only MainLoop should change the Pri*)
		res := 1;
		i := 0; j := 0;
		WHILE name[j] # 0X DO
			IF name[j] = "." THEN i := j END;
			INC(j)
		END;
		IF i > 0 THEN
			name[i] := 0X;
			IF new THEN Modules.Free(name, FALSE) END;
			Mod := Modules.ThisMod(name);
			IF Modules.res = 0 THEN
				INC(i); j := i;
				WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END;
				name[j - i] := 0X;
				P := Modules.ThisCommand(Mod, name);
				IF Modules.res = 0 THEN
					Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0
				ELSE
					res:=Modules.res
				END
			ELSE res := Modules.res
			END
		END;
		(*Amiga.Idle  (* set task priority low *)*) 	(*<<RD only MainLoop should change the Pri*)
	END Call;
	PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
		VAR M: SelectionMsg;
	BEGIN
		M.time := -1; Viewers.Broadcast(M); time := M.time;
		IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END
	END GetSelection;
	PROCEDURE GC;
	BEGIN
		IF ActCnt<=0 THEN
			Kernel.GC(TRUE);
			ActCnt:=BasicCycle
		END
	END GC;
	PROCEDURE Install* (T: Task);
		VAR t: Task;
	BEGIN t := PrevTask;
		WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END;
		IF t.next # T THEN T.next := PrevTask; t.next := T END
	END Install;
	PROCEDURE Remove* (T: Task);
		VAR t: Task;
	BEGIN t := PrevTask;
		WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END;
		IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END;
		IF CurTask = T THEN CurTask := PrevTask.next END
	END Remove;
	PROCEDURE Collect* (count: INTEGER);
	BEGIN
		ActCnt := count
	END Collect;
	PROCEDURE SetFont* (fnt: Fonts.Font);
	BEGIN
		CurFnt := fnt
	END SetFont;
	PROCEDURE SetColor* (col: SHORTINT);
	BEGIN CurCol := col
	END SetColor;
	PROCEDURE SetOffset* (voff: SHORTINT);
	BEGIN CurOff := voff
	END SetOffset;
	PROCEDURE NotifyTasks;	(* << JT *)
		Call handler of all those task, which have set their time field to -1.
		VAR t0, t1: Task;
	BEGIN t0 := PrevTask;
		REPEAT
			CurTask := PrevTask.next;
			IF CurTask.time = -1 THEN
				IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
				t1 := CurTask; CurTask.handle; PrevTask.next := CurTask;
				IF CurTask # t1 THEN RETURN END (*detect Remove(CurTask)*)
			END;
			PrevTask := CurTask
		UNTIL CurTask = t0
	END NotifyTasks;
	PROCEDURE NotifyAllTasks;	(* << RD for Time depending MainLoop *)
		Call handler of all those task, which have set their time field to -1.
		VAR t0, t1: Task; ti: LONGINT;
	BEGIN 
		t0 := PrevTask;
		ti:=Input.Time();
		REPEAT
			CurTask := PrevTask.next;
			IF (CurTask.time <= ti) & (CurTask.time # -1) THEN
				IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
				t1 := CurTask; CurTask.handle; PrevTask.next := CurTask;
				IF CurTask # t1 THEN RETURN END (*detect Remove(CurTask)*)
			END;
			PrevTask := CurTask
		UNTIL CurTask = t0
	END NotifyAllTasks;
	PROCEDURE Loop*;
		The Oberon loop. The "task scheduler" of Oberon.
		TYPE
			winptr = POINTER TO AmigaIntuition.Window;
		VAR
			frame:RECORD END;
			V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
			prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
			VM: Viewers.ViewerMsg;	(* << *)
			LastLoopType: BOOLEAN;   (* <> *)
			win: winptr;	(*<<RD*)
		PROCEDURE HandleChar();	(*<RD*)
			VAR
				chint: INTEGER;
				dumMod: Modules.Module;
		BEGIN
			Input.Read(ch);
			chint:=ORD(ch);
			IF ch = ESC THEN
				N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
			ELSIF ch = SETUP THEN
				N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N)
			ELSIF ch = 0CX THEN	(* << Form Feed => refresh display*)
				N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer);
				VM.id := Viewers.suspend; Viewers.Broadcast(VM);
				VM.id := Viewers.restore; Viewers.Broadcast(VM)
			ELSIF (chint>245) & (chint<255) THEN	(*<RD  F6-F10, HELP and Clipboard-Keys *)
				IF (chint>251) & (Kernel.FKey[13]=NIL) THEN dumMod:=Modules.ThisMod("Clipboard") END;
				IF Kernel.FKey[chint-240]#NIL THEN Kernel.FKey[chint-240] END;
			ELSIF ch = 0EFX THEN
				Amiga.Terminate
			ELSE
				M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff;
				FocusViewer.handle(FocusViewer, M);
				DEC(ActCnt); NotifyTasks
			END
		END HandleChar;
	BEGIN
			Remember the current stack, so that the Kernel's stack collector knows where to look for pointers.
		LastLoopType:=Amiga.TicsToWait=0;			(* <> *)
		Kernel.stackBottom := SYSTEM.ADR(frame);	(* << *)
		prevX:=-1; prevY:=1;
		win:=SYSTEM.VAL(winptr, Amiga.window);
		LOOP
			IF AmigaIntuition.windowActive IN win.flags THEN
				Input.Mouse(keys, X, Y);
			ELSE
				X:=prevX; Y:=prevY; keys:={};
			END;
			IF Amiga.TicsToWait>0 THEN (* Time depending MainLoop *)
				IF ~LastLoopType THEN Amiga.Turbo; LastLoopType:=TRUE END;
				IF Input.Available() > 0 THEN
					(*
						Handle all special characters, before handling the standard case.
					*)
					HandleChar();	(*<RD*)
				ELSIF keys # {} THEN
					(*
						As long, as a mouse key is pressed, send messages to the viewer on which the cursor
						is placed. Return to the loop only, when all mouse keys have been released.
					*)
					M.id := track; M.X := X; M.Y := Y; M.keys := keys;
					REPEAT
						V := Viewers.This(M.X, M.Y); V.handle(V, M);
						Input.Mouse(M.keys, M.X, M.Y)
					UNTIL M.keys = {};
					DEC(ActCnt); NotifyTasks
				ELSIF V24.Available() > 0 THEN
					(*
						Char available at the Serial Device => It is an event => notify ALL tasks
					*)
					NotifyTasks
				ELSE
					(*
						On mouse coordinate change notify the viewer below the actual mouse position.
					*)
					IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
						M.id := track; M.X := X; M.Y := Y; M.keys := {}; V := Viewers.This(X, Y);
						V.handle(V, M);
						prevX := X; prevY := Y
					END;
					(*
						Call handler of background task with a time not in the future and advance task pointer to next ready task.
						Tasks which are called by NotifiyTask (time=-1) are not called here.
					*)
					NotifyAllTasks
				END;
				AmigaTimer.Wait(0, Amiga.TicsToWait)
			ELSE (* ever running MainLoop, low Task-Pri *)
					(* This is the way nearer the original *)
				IF LastLoopType THEN Amiga.Idle; LastLoopType:=FALSE END;
				IF Input.Available() > 0 THEN
					(*
						Handle all special characters, before handling the standard case.
					*)
					Amiga.Turbo;
					HandleChar();	(*<RD*)
					Amiga.Idle
				ELSIF keys # {} THEN
					(*
						As long, as a mouse key is pressed, send messages to the viewer on which the cursor
						is placed. Return to the loop only, when all mouse keys have been released.
					*)
					Amiga.Turbo;
					M.id := track; M.X := X; M.Y := Y; M.keys := keys;
					REPEAT
						V := Viewers.This(M.X, M.Y); V.handle(V, M);
						Input.Mouse(M.keys, M.X, M.Y)
					UNTIL M.keys = {};
					DEC(ActCnt); NotifyTasks;
					Amiga.Idle
				ELSIF V24.Available() > 0 THEN
					(*
						Char available at the Serial Device => It is an event => notify ALL tasks
					*)
					NotifyTasks
				ELSE
					(*
						On mouse coordinate change notify the viewer below the actual mouse position.
					*)
					IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
						Amiga.Turbo;
						M.id := track; M.X := X; M.Y := Y; M.keys := {}; V := Viewers.This(X, Y);
						V.handle(V, M);
						prevX := X; prevY := Y;
						Amiga.Idle
					END;
					(*
						Call handler of background task with a time not in the future and advance task pointer to next ready task.
						Tasks which are called by NotifiyTask (time=-1) are not called here.
					*)
					CurTask := PrevTask.next;
					IF (CurTask.time <= Input.Time()) & (CurTask.time # -1) THEN
						IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
						CurTask.handle; PrevTask.next := CurTask
					END;
					PrevTask := CurTask
				END
			END
		END
	END Loop;
	PROCEDURE Init;
	BEGIN
		User[0] := 0X;
		Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
		Star.Fade := FlipStar; Star.Draw := FlipStar;
		OpenCursor(Mouse); OpenCursor(Pointer);
		DW := Display.Width; DH := Display.Height; CL := Display.ColLeft;
		H3 := DH - DH DIV 3;
		H2 := H3 - H3 DIV 2;
		H1 := DH DIV 5;
		H0 := DH DIV 10;
		unitW := DW DIV 8;
		OpenDisplay(unitW * 5, unitW * 3, DH);
		FocusViewer := Viewers.This(0, 0);
		CurFnt := Fonts.Default;
		CurCol := Display.white;
		CurOff := 0;
		Collect(BasicCycle);
		NEW(PrevTask);
		PrevTask.handle := GC;
		PrevTask.safe := TRUE;
		PrevTask.time := -1;	(* << (instead of 0) JT *)
		PrevTask.next := PrevTask;
		Display.SetMode(0, {})
	END Init;
BEGIN Init;
	(* only if System not in boot file: *)
	Mod:=Modules.ThisMod("System")
END Oberon.